home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ASTRONOM / 2191.ZIP / SHOW.ZIP / COLOR3D.BAS < prev    next >
BASIC Source File  |  1986-01-29  |  7KB  |  140 lines
  1. 1000 '                  ********* COLOR3D.BAS *********
  2. 1010 '  Draws a 3D, perspective image of a molecule on IBM PCs with BASICA.
  3. 1020 '                For private, noncommercial use only.
  4. 1030 '                 John J. Farrell *** April 1, 1985
  5. 1040 ' Inspired by Earl Kirkland's MODEL3D.BAS for the Mac, BYTE, Feb. 1985.
  6. 1050 SCREEN 1    'medium resolution; color
  7. 1060 COLOR 0,1    'background = black(0); cyan(1); magenta(2); white(3)
  8. 1070 KEY OFF
  9. 1080 DEFINT I-N: DEFSNG O-Z: DEFSNG A-G
  10. 1090 DIM X(200), Y(200), Z(200), S(200), COL(200),COLPAT(200),TIL$(200)
  11. 1100 '
  12. 1110 ' Ask for input parameters.
  13. 1120 CLS: INPUT "Data file name:", FILE$
  14. 1130 INPUT "Azim., polar angles (phi, theta):", PHI, THETA
  15. 1140 INPUT "Viewing distance:",VIEWD
  16. 1150 INPUT "Size magnitude:",SMAG
  17. 1160 SMAG = 1.15*SMAG
  18. 1170 ' DISTORT is used later to account for fact that one unit of x
  19. 1180 ' on screen (horizonal) is not equal to one unit of z (vertical).
  20. 1190 DISTORT = 1.2
  21. 1200 ' Convert degrees to radians.
  22. 1210 PHI = PHI*3.14159/180!: THETA = THETA*3.14159/180!
  23. 1220 CP = COS(PHI): SP = SIN(PHI): CT = COS(THETA): ST = SIN(THETA)
  24. 1230 '
  25. 1240 OPEN FILE$ FOR INPUT AS #1
  26. 1250 ' Set xmin very large and xmax very small.
  27. 1260 XMIN = 1000000!: XMAX = -XMIN: YMIN = XMIN: YMAX = XMAX
  28. 1270 ZMIN = XMIN: ZMAX = XMAX: N = 0
  29. 1280 ' Read data file: color, x,y,z (atomic coords),r (Angstroms).
  30. 1290 WHILE NOT EOF(1)
  31. 1300 N = N + 1
  32. 1310 INPUT #1,COLPAT(N), X(N),Y(N), Z(N), S(N)
  33. 1320 IF COLPAT(N)<= 3 THEN COL(N) = COLPAT(N): TIL$(N) = CHR$(&HAA)
  34. 1330 IF COLPAT(N) = 4 THEN COL(N) = 1: TIL$(N) =CHR$(&H66) + CHR$(&H99)
  35. 1340 IF COLPAT(N) = 5 THEN COL(N) = 3: TIL$(N) = CHR$(&HAF) +CHR$(&HAF) + CHR$(&HFA) + CHR$(&HFA)
  36. 1350 IF COLPAT(N) = 6 THEN COL(N) = 2: TIL$(N) =CHR$(&H55) + CHR$(&HFF)
  37. 1360 IF COLPAT(N) = 7 THEN COL(N) = 3: TIL$(N) = CHR$(&HAA) + CHR$(&H69) + CHR$(&HFF) + CHR$(&H5A) + CHR$(&HA5) + CHR$(&HFF) + CHR$(&H96) + CHR$(&HAA)
  38. 1370 IF COLPAT(N) = 8 THEN COL(N) = 3: TIL$(N) = CHR$(&H5A) + CHR$(&H5A) + CHR$(&HA5) + CHR$(&HA5)
  39. 1380 IF COLPAT(N) = 9 THEN COL(N) = 3: TIL$(N) = CHR$(&HAA) + CHR$(&HAA) + CHR$(&H55) + CHR$(&H55)
  40. 1390 IF COLPAT(N) = 10 THEN COL(N) = 3: TIL$(N) = CHR$(&HAA) + CHR$(&HFF)
  41. 1400 IF COLPAT(N) = 11 THEN COL(N) = 3: TIL$(N) = CHR$(&H5F) + CHR$(&H5F) + CHR$(&HF5) + CHR$(&HF5)
  42. 1410 IF COLPAT(N) = 12 THEN COL(N) = 3: TIL$(N) = CHR$(&H69) + CHR$(&HAA) + CHR$(&HAA) + CHR$(&H96)
  43. 1420 IF COLPAT(N) = 13 THEN COL(N) = 3: TIL$(N) = CHR$(&HBB)
  44. 1430 IF COLPAT(N) = 14 THEN COL(N) = 3: TIL$(N) = CHR$(&HAB)
  45. 1440 IF COLPAT(N) = 15 THEN COL(N) = 3: TIL$(N) = CHR$(&H57)
  46. 1450 IF COLPAT(N) = 16 THEN COL(N) = 3: TIL$(N) = CHR$(&HAB) + CHR$(&HAB) + CHR$(&HFF) + CHR$(&HFF)
  47. 1460 IF COLPAT(N) = 17 THEN COL(N) = 3: TIL$(N) = CHR$(&H57) + CHR$(&H57) + CHR$(&HFF) + CHR$(&HFF)
  48. 1470 IF COLPAT(N) = 18 THEN COL(N) = 3: TIL$(N) = CHR$(&HFE) + CHR$(&HFA) + CHR$(&HFA) + CHR$(&HEA) + CHR$(&HFA) + CHR$(&HFE)
  49. 1480 IF COLPAT(N) = 19 THEN COL(N) = 3: TIL$(N) = CHR$(&HEB) + CHR$(&HAA) + CHR$(&HAA) + CHR$(&HEB)
  50. 1490 IF COLPAT(N) = 20 THEN COL(N) = 3: TIL$(N) = CHR$(&H77)
  51. 1500 IF COLPAT(N) = 21 THEN COL(N) = 3: TIL$(N) = CHR$(&H69) + CHR$(&HAA) + CHR$(&HAA) + CHR$(&H69)
  52. 1510 IF COLPAT(N) = 22 THEN COL(N) = 3: TIL$(N) = CHR$(&HAA) + CHR$(&HBE) + CHR$(&HBE) + CHR$(&HBE) + CHR$(&HBE) + CHR$(&HAA)
  53. 1520 IF COLPAT(N) = 23 THEN COL(N) = 3: TIL$(N) = CHR$(&HE9) + CHR$(&H9E)
  54. 1530 IF COLPAT(N) = 24 THEN COL(N) = 3: TIL$(N) = CHR$(&HE9) + CHR$(&HE9)
  55. 1540 ' Find maximum and minimum values for x,y,z.
  56. 1550 IF X(N) > XMAX THEN XMAX = X(N)
  57. 1560 IF X(N) < XMIN THEN XMIN = X(N)
  58. 1570 IF Y(N) > YMAX THEN YMAX = Y(N)
  59. 1580 IF Y(N) < YMIN THEN YMIN = Y(N)
  60. 1590 IF Z(N) > ZMAX THEN ZMAX = Z(N)
  61. 1600 IF Z(N) < ZMIN THEN ZMIN = Z(N)
  62. 1610 WEND
  63. 1620 PRINT N "atoms"
  64. 1630 PRINT "rotating..."
  65. 1640 ' Find center values for x,y,z.
  66. 1650 XCEN = .5*(XMAX+XMIN): YCEN = .5*(YMIN + YMAX): ZCEN = .5*(ZMIN+ZMAX)
  67. 1660 ' Rotate molecule around its center.
  68. 1670 FOR I = 1 TO N
  69. 1680 XA = X(I) - XCEN: YA = Y(I) - YCEN
  70. 1690 X(I) = CP*XA+SP*YA: Y(I) = -SP*XA+CP*YA
  71. 1700 YA = Y(I): ZA = Z(I) - ZCEN
  72. 1710 Y(I) = CT*YA+ST*ZA: Z(I) = -ST*YA+CT*ZA
  73. 1715 IF VIEWD < Y(I) THEN CLS: PRINT "Viewing distance is within molecule!    Rerun with a larger viewing distance.": GOTO 2100
  74. 1720 NEXT I: PRINT "sorting..."
  75. 1730 '
  76. 1740 ' Sort by depth (shell sort).
  77. 1750 IGAP = INT(CSNG(N)/2!)
  78. 1760 WHILE IGAP >= 1
  79. 1770 FOR I = IGAP +1 TO N
  80. 1780 FOR J = I-IGAP TO 1 STEP -IGAP
  81. 1790 JG = J + IGAP
  82. 1800 IF Y(J) <= Y(JG) THEN GOTO 1850
  83. 1810 SWAP X(J),X(JG): SWAP Y(J), Y(JG)
  84. 1820 SWAP Z(J), Z(JG): SWAP S(J), S(JG)
  85. 1830 SWAP COL(J), COL(JG): SWAP COLPAT(J), COLPAT(JG): SWAP TIL$(J),TIL$(JG)
  86. 1840 NEXT J
  87. 1850 NEXT I
  88. 1860 IGAP = INT(CSNG(IGAP)/2!)
  89. 1870 WEND
  90. 1880 '
  91. 1890 CLS
  92. 1900 ' Perspective projection and scale coordinates.
  93. 1910 SCALE = -1000000!: SMAX = SCALE
  94. 1920 FOR I = 1 TO N
  95. 1930 YA = 1!/(VIEWD - Y(I)): X(I) = X(I) *YA: Z(I) = Z(I) * YA: S(I) = S(I)*YA
  96. 1940 IF SCALE < ABS(X(I)) THEN SCALE = ABS(X(I))
  97. 1950 IF SCALE < ABS(Z(I)) THEN SCALE = ABS(Z(I))
  98. 1960 IF SMAX <S(I) THEN SMAX = S(I)
  99. 1970 NEXT I: SCALE = 75!/(SCALE + .5*SMAX*SMAG)
  100. 1980 SCALEX = SCALE*DISTORT
  101. 1990 '
  102. 2000 FOR I = 1 TO N
  103. 2010 ' Find screen x (ix) and screen z (iz) and screen radius (ir).
  104. 2020 ' Center of screen is x = 160 and z = 100.
  105. 2030 IX = INT(X(I)*SCALEX+ 160!): IZ = INT(Z(I)*SCALE + 100!)
  106. 2040 IR = INT(S(I)*SCALE*SMAG): IRZ = IR/DISTORT
  107. 2050 COL = COL(I): COLPAT = COLPAT(I): TIL$ = TIL$(I)
  108. 2060 GOSUB 2130
  109. 2070 NEXT I
  110. 2080 CLOSE#1
  111. 2090 IF INKEY$ = "" THEN 2090
  112. 2100 END
  113. 2110 ' Draw patterned circles at ix,iz with radius ir.
  114. 2120 ' Draw a circle in color.
  115. 2130 CIRCLE (IX,IZ),IR+1,COL
  116. 2140 ' Paint the circle black.  Start in center and at four extremities
  117. 2150 'in an attempt to completely blacken the circle.
  118. 2160 PAINT (IX,IZ),0,COL: PAINT (IX-IR+1,IZ),0,COL: PAINT (IX+IR-1,IZ),0,COL: PAINT (IX,IZ-IRZ+1),0,COL: PAINT (IX,IZ+IRZ-1),0,COL
  119. 2170 ' Paint the circle in color.
  120. 2180 PAINT (IX,IZ),COL,COL: PAINT (IX-IR+1,IZ),COL,COL: PAINT (IX+IR-1,IZ),COL,COL: PAINT (IX,IZ-IRZ+1),COL,COL: PAINT (IX,IZ+IRZ-1),COL,COL
  121. 2190 ' Draw circle with a new border color and paint black.
  122. 2200 IF COL = 1 THEN COLBOR = 3
  123. 2210 IF COL = 2 THEN COLBOR = 3
  124. 2220 IF COL = 3 THEN COLBOR = 1
  125. 2230 CIRCLE (IX,IZ),IR+1,COLBOR
  126. 2240 PAINT (IX,IZ),0,COLBOR
  127. 2250 ' Paint circle with final pattern.
  128. 2260 IF COLPAT <=3 THEN PAINT (IX,IZ),COL,COLBOR ELSE PAINT (IX,IZ),TIL$,COLBOR
  129. 2270 ' Draw the circle in black and paint it black.
  130. 2280 CIRCLE (IX,IZ),IR+1,0
  131. 2290 PAINT (IX,IZ),0,0: PAINT (IX-IR+1,IZ),0,0: PAINT (IX+IR-1,IZ),0,0: PAINT (IX,IZ-IRZ+1),0,0: PAINT (IX,IZ+IRZ-1),0,0
  132. 2300 ' Draw the circle in color and paint with final pattern.
  133. 2310 CIRCLE (IX,IZ),IR+1,COLBOR
  134. 2320 IF COLPAT <=3 THEN PAINT (IX,IZ),COL,COLBOR ELSE PAINT (IX,IZ),TIL$,COLBOR
  135. 2330 ' Draw the circle in black.
  136. 2340 CIRCLE (IX,IZ),IR+1,0
  137. 2350 RETURN
  138.  (IX,IZ),COL,COLBOR ELSE PAINT (IX,IZ),TIL$,COLBOR
  139. 2330 ' Draw the circle in black.
  140. 2340 CI